home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1996 #15
/
Monster Media Number 15 (Monster Media)(July 1996).ISO
/
pcboard
/
pwrap110.zip
/
PCBWRAP.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-04-10
|
17KB
|
468 lines
{$M 8192,0,655360}
{$N-,E- no math support needed}
{$X- function calls may not be discarded}
{$I- disable I/O checking (trap errors by checking IOResult)}
PROGRAM wrapPCBoardDirfile;
(*--------------------------------------------------------------------------
REVISION HISTORY
v1.00 : 1993/07/14. First public release.
v1.00a : 1993/08/19. Cosmetic corrections in .DOC and .DIZ files.
v1.01 : 1993/08/27. Fixed bug: would not properly process files in
directories other than the current one.
v1.01a : 1993/09/09. Added ability to set right margin (SET margin=xxx).
Now displays program ID & info. only if an error is
encountered. (Less display "clutter".)
v1.02 : 1993/09/16. Increased left margin flexibility: can be any width,
except that it cannot exceed the difference between
the right margin specification and 44.
More cosmetic work on .DOC file.
v1.03 : 1993/11/01. Quashed minor bug: would loop if line did not wrap.
v1.04 : 1993/12/01. Now preserves blank lines outside of descriptions.
v1.05 : 1993/12/09. Now preserves original file date and time.
v1.06 : 1994/08/09. Reworked source code, major overhaul - much more
robust and efficient (and no larger either!).
Now deletes control codes and box/ line drawing chars.
Now preserves ALL blank lines.
v1.10 : 1996/04/10. Polished source code a little, maybe slightly faster
and more robust now.
--------------------------------------------------------------------------*)
(*
example of a description, with two possible "prepipe|postpipe" specifications
PKZ204G.EXE 203019 02-08-93 PKZIP/PKUNZIP v2.04g; PKWare's compression
| utilities. More, minor bug fixes relative to version 2.04e See V204G.NEW for
| details; by Phil Katz/PKWare
^
^<- prepipe|postpipe of 1:1
PKZ204G.EXE 203019 02-08-93 PKZIP/PKUNZIP v2.04g; PKWare's compression
| utilities. More, minor bug fixes relative to
| version 2.04e See V204G.NEW for details; by
| Phil Katz/PKWare
prepipe|postpipe of 31:1 ->^
*)
USES DOS;
TYPE
FList = ^FNode;
FNode = RECORD
fName: DIRSTR; { Full file names of files to process. }
Next: FList;
END;
CONST
colon = #58; pipe = #124; { "pipe" is the "|" symbol, these are my }
hyphen = #45; space = #32; { simple ways of minimizing typing errors }
minwidth = 44; { minimum width of descriptions }
maxleft = 78; { maximum LEFT margin, including the }
{ spaces before and after the pipe }
VAR { GLOBAL vars }
FileList : FList; { Singly linked list of files to process. }
nostrip : BOOLEAN; { remove "Files: ", "Uploaded by: ", etc? }
{ (read from a DOS environment variable) }
prepipe, { spaces before the pipe }
postpipe : STRING; { spaces after the pipe }
rightmargin : BYTE; { right margin as a number }
PROCEDURE WriteStr (CONST s: STRING); FORWARD;
PROCEDURE ShowHelp (problem : BYTE);
(*
If any *foreseen* errors arise, we are sent
here to give a little help and exit (relatively) peacefully
*)
CONST
NL = #13#10;
VAR
message : STRING [79];
BEGIN
WriteStr ('PCBWrap v1.10 - Free DOS utility: PCBoard filelist offline reformatter.');
WriteStr ('April 10, 1996. Copyright (c) 1996 by David Daniel Anderson - Reign Ware.'+NL);
WriteStr ('Usage: PCBWrap file(s)_to_wrap [prepipe[:postpipe]] (1..79, default = 1:1)'+NL);
IF problem > 0 THEN BEGIN
CASE problem OF
1 : message := 'The difference between the right and left margins must be 44 or greater.';
2 : message := 'The second parameter is NOT a valid numeric!';
3 : message := 'No files found. First parameter must be a valid file specification.';
6 : message := 'You cannot just specify a path, add "*.*" or "\*.*" for all files.';
7 : message := 'Error opening, closing, or renaming a file. Original may be renamed!';
ELSE message := 'Unknown error.';
END;
WriteStr ('Error encountered:'); WriteStr (message);
END;
Halt (problem);
END;
PROCEDURE CheckIO;
BEGIN
IF IOResult <> 0 THEN ShowHelp (7);
END;
FUNCTION IsDir (CONST FileName: PATHSTR): BOOLEAN;
VAR
Attr : WORD;
cFile : FILE;
BEGIN
Assign (cFile, FileName);
GetFAttr (cFile, Attr);
IF (DosError = 0) AND ((Attr AND Directory) = Directory)
THEN IsDir := TRUE
ELSE IsDir := FALSE;
END;
FUNCTION GetFilePath (CONST PSTR: PATHSTR; VAR sDir: DIRSTR): PATHSTR;
VAR
jPath : PATHSTR; { file path, }
jDir : DIRSTR; { directory, }
jName : NAMESTR; { name, }
jExt : EXTSTR; { extension. }
BEGIN
jPath := PSTR;
IF jPath = '' THEN jPath := '*.*';
IF (NOT (jPath [Length (jPath)] IN [':', '\'])) AND IsDir (jPath) THEN
jPath := jPath + '\';
IF (jPath [Length (jPath)] IN [':', '\']) THEN
jPath := jPath + '*.*';
FSplit (FExpand (jPath), jDir, jName, jExt);
jPath := jDir + jName+ jExt;
sDir := jDir;
GetFilePath := jPath;
END;
PROCEDURE WriteStr (CONST s: STRING);
BEGIN
WriteLn (s);
END;
PROCEDURE OpenFiles (VAR file_in, file_out : TEXT; Name1, Name2 : STRING);
BEGIN
Assign (file_in, Name1);
Reset (file_in); CheckIO;
Assign (file_out, Name2);
Rewrite (file_out); CheckIO;
END;
FUNCTION GetRightMargin : BYTE;
CONST
default_rm = 78; { default RIGHT margin }
VAR
rm : SHORTINT; { right margin as an integer }
valerr : INTEGER; { used when converting env var "margin" to number }
BEGIN
Val (GetEnv ('margin'), rm, valerr);
IF (valerr <> 0)
THEN rm := default_rm
ELSE
IF NOT rm IN [minwidth + 3..minwidth + 3 + maxleft]
THEN rm := default_rm;
GetRightMargin := rm;
END;
PROCEDURE CreateString (digits : STRING; VAR longstr : STRING);
(* Create a string ("longstr") "digits"/"slen" in length *)
VAR
slen : BYTE; { numeric of string containing numbers needed }
pcode : INTEGER; { error code:
will be non-zero if strings are not numbers }
BEGIN
Val (digits, slen, pcode);
IF (pcode <> 0) THEN
ShowHelp (1); { out of range }
IF NOT (slen IN [1..maxleft]) THEN
ShowHelp (2); { numeric conversion error }
longstr [0] := Chr (slen);
FillChar (longstr [1], slen, space);
END;
FUNCTION GetLeftMargin (VAR pre_p, post_p : STRING) : BYTE;
(*
Determine number of spaces to put before and after the pipe character
(based on the second command line parameter, or a default)
*)
VAR
PSTR : STRING [5]; { entire string containing numbers needed }
BEGIN
(*
If the second parameter has a colon, the number before the colon will be
"pre_p", and the number after will be "post_p".
If a colon is not present, pre_p should be entire parameter (post_p=1).
*)
PSTR := ParamStr (2); {first parameter is filespec, second is dimensions }
IF ((Pos (colon, PSTR)) > 1) THEN
BEGIN
CreateString (Copy (PSTR, 1, ((Pos (colon, PSTR)) - 1)), pre_p);
CreateString (Copy (PSTR, ((Pos (colon, PSTR)) + 1), Length (PSTR)), post_p);
END
ELSE
CreateString (PSTR, pre_p);
GetLeftMargin := Length (pre_p+ pipe+ post_p);
END;
FUNCTION SqueezeStr (longstr : STRING) : STRING;
(* Remove extra spaces, low and most of high ASCII, and leading pipes *)
VAR newstr : STRING;
index : BYTE; { hold our place in string }
BEGIN
newstr := longstr;
FOR index := 1 TO Length (newstr) DO {strip box/line chars, control codes}
IF Ord (newstr [index]) IN [0..31, 169, 170, 174..223, 240..245, 247..250, 254, 255]
THEN newstr [index] := space;
WHILE (Length (newstr) > 1) AND (Pos (space+space, newstr) <> 0)
DO Delete (newstr, Pos (space+ space, newstr), 1);
WHILE (newstr <> '') AND (newstr [Length (newstr)] = space)
DO Dec (newstr [0]);
WHILE (newstr <> '') AND (newstr [1] IN [space, pipe])
DO Delete (newstr, 1, 1);
SqueezeStr := newstr;
END;
FUNCTION WrapLine (VAR thefile : TEXT; theline : STRING) : STRING;
(* Split line after rightmargin character or nearest preceding space *)
VAR
parta, partb : STRING; { first and second part of line }
breakchar : STRING [1]; { character which will eventually be a space }
breakfound : BOOLEAN;
breakpos : BYTE;
BEGIN
breakpos := rightmargin + 2;
breakfound := FALSE;
(*
Search for a space or a hyphen or the ASCII 255 non-displaying char,
by decrementing the breakpos while checking validity
*)
WHILE ((NOT breakfound) AND (breakpos > Length (prepipe+ postpipe) + 2)) DO
BEGIN
Dec (breakpos);
breakfound := theline [breakpos] IN [space, hyphen, #255];
END;
IF NOT breakfound {if unable to find a valid breakpoint, break at max width}
THEN breakpos := rightmargin + 1;
parta := Copy (theline, 1, breakpos - 1);
partb := Copy (theline, breakpos + 1, Length (theline) - (breakpos));
breakchar := theline [breakpos];
IF NOT (breakchar [1] IN [space, #255]) THEN {save non-blank breakchar}
IF breakpos <= rightmargin
THEN parta := parta + breakchar
ELSE partb := breakchar + partb;
(*
Write the first part to the file,
and then return the second part (after adding prepipe and postpipe).
*)
WriteLn (thefile, parta);
WrapLine := (prepipe+ pipe+ postpipe+ partb);
END;
PROCEDURE ProcessLine (VAR nextline, thisline : STRING);
CONST
files1 = 'Files: '; {7}
files2 = '(Files: '; {8}
uplby1 = 'Uploaded by: '; {13}
uplby2 = 'Uploaded By: '; {13}
dcount = 'Download Count: '; {16}
BEGIN
(*
First remove upload status lines (unless otherwise instructed),
then remove spaces ("SqueezeStr" function)
*)
IF (NOT (nostrip)) AND (Ord (nextline [0]) > 40) THEN
IF ((Pos (files1, nextline) = 34) OR
(Pos (files2, nextline) = 34) OR
(Pos (uplby1, nextline) = 34) OR
(Pos (uplby2, nextline) = 34) OR
(Pos (dcount, nextline) = 34))
THEN { remove that description line }
nextline := Copy (nextline, 1, 33);
(*
If the next line still exists, then join current and next line with a
space between them for a word delimiter. However, if the last char of
the current line is a hyphen, and the character preceding it is -not-
a space, then DO NOT add a space. This is to force hyphenated words
to reconnect (eg. "hyphen-ation" instead of "hyphen- ation").
*)
nextline := SqueezeStr (nextline);
IF (Length (nextline) > 0) AND (thisline [Length (thisline)] <> space)
THEN
IF NOT ((thisline [Length (thisline)] = hyphen) AND
(thisline [Length (thisline) - 1] <> space))
THEN thisline := thisline+ space;
thisline := thisline+ nextline;
END;
FUNCTION IsFirstLine (currentline : STRING) : BOOLEAN;
VAR isfirst : BOOLEAN; { is this the first line of a file desc? }
valsize : LONGINT; { filesize }
valcode : INTEGER; { will give error if filesize not a number }
BEGIN
(*
Determine a valid first line by looking for a non-space/ control char in
the first position, and verifying file size, date, and proper spacing
between the size and date (file size is a number in columns 15-21).
*)
isfirst := FALSE;
IF ((Length (currentline) > 30) AND (currentline [1] > space)) THEN BEGIN
Val (Copy (currentline, 15, 7), valsize, valcode);
IF (valcode = 0) THEN
isfirst := ((currentline [26] = hyphen) AND (currentline [29] = hyphen) AND
(currentline [22] = space) AND (currentline [23] = space));
END;
IsFirstLine := isfirst;
END;
PROCEDURE MakeNewFile (VAR source, dest : TEXT); { actually rewrite the file }
VAR
crnline, { the line currently on hold, already processed }
freshline : STRING; { the line just read, now being processed }
indesc, { have we found a first line of a description ? }
first : BOOLEAN; { if this is first line of FILE, do NOT write }
{ it to a new file unless it is the beginning }
{ of a new description }
BEGIN
first := TRUE; { Initialize some vars... }
indesc := FALSE;
REPEAT
FillChar (freshline, SizeOf (freshline), 0); { clear out old line !!! }
ReadLn (source, freshline);
IF ((freshline [1] = space) AND indesc) THEN {Process description line }
ProcessLine (freshline, crnline) { Join lines and pack the result }
ELSE BEGIN { First char not a space, or not processing a description, }
IF (NOT first) THEN
WriteLn (dest, crnline); {just write the processed line, and move on}
crnline := freshline;
indesc := IsFirstLine (crnline); { Perhaps it starts a new filedesc }
IF indesc THEN { YES!, we are in a new description! }
crnline := Copy (crnline, 1, 31) + ' ' +
SqueezeStr (Copy (crnline, 34, Length (crnline) - 33)); {pack description}
END;
IF indesc THEN WHILE Length (crnline) > rightmargin DO
crnline := WrapLine (dest, crnline);
first := FALSE;
UNTIL EoF (source); { loop back to read another line - PHEW! }
WriteLn (dest, crnline); { last line of file, was already processed }
END;
PROCEDURE BuildFileList (fPath: PATHSTR; fDir: DIRSTR);
VAR
nFiles: WORD;
cFile: SEARCHREC;
Anchor, TempNode: FList;
BEGIN
nFiles := 0;
Anchor := NIL;
FileList := NIL;
FindFirst (fPath, Archive, cFile);
WHILE DosError = 0 DO { Add to linked list }
BEGIN
Inc (nFiles);
New (TempNode);
TempNode^.fName := fDir + cFile.Name;
TempNode^.Next := NIL;
IF FileList <> NIL
THEN FileList^.Next := TempNode
ELSE Anchor := TempNode;
FileList := TempNode;
FindNext (cFile);
END;
FileList := Anchor;
IF (nFiles = 0) THEN ShowHelp (3);
WriteLn ('PCBWrap found ', nFiles, ' file(s) to process.');
END;
PROCEDURE ProcessFiles (sdir: DIRSTR);
{ Traverse linked list, processing each file. }
CONST
destfname = 'pwraptmp.dst';
tempfname = 'pwraptmp.tmp';
VAR
sfn, dfn, tfn : PATHSTR; { Source/ Dest/ Temp FileName, including dir }
infile, outfile : TEXT; { files read from/ written to }
filedt : LONGINT; { file date and time, to preserve original }
numdone : WORD; { numdone is number of files wrapped }
TempNode: FList;
pNum: BYTE;
ArcPos: BYTE;
fExt: EXTSTR;
BEGIN
dfn := sdir + destfname;
tfn := sdir + tempfname;
numdone := 0;
WHILE FileList <> NIL DO BEGIN
WITH FileList^ DO BEGIN
Inc (numdone);
sfn := fName;
Write ('Wrapping ', sfn); { tell user this file is being processed }
OpenFiles (infile, outfile, sfn, dfn);
MakeNewFile (infile, outfile);
WriteStr (', done!'); { tell user this file has been processed }
(*
Swap file names, preserving the original date and time
(need to "flush" file so new date/ time sticks)
*)
GetFTime (infile, filedt); Close (infile); CheckIO;
Close (outfile); CheckIO; Reset (outfile); CheckIO;
SetFTime (outfile, filedt); Close (outfile); CheckIO;
Rename (infile, tfn); CheckIO;
Rename (outfile, sfn); CheckIO;
Erase (infile); CheckIO;
END;
TempNode := FileList;
FileList := FileList^. Next; { Clean up after ourselves. }
Dispose (TempNode);
END;
WriteLn ('PCBWrapped ', numdone, ' file(s).');
END;
VAR
fPath: PATHSTR;
fDir: DIRSTR;
(* BEGIN the "main" program *)
BEGIN
(*
Initialize some variables.
Prepipe and postpipe begin as single spaces.
The user must pass a filename (first parameter), and
may optionally pass a margin specification (second parameter),
which must allow at least 44 characters for the description.
*)
IF NOT (ParamCount IN [1..2]) THEN ShowHelp (0);
nostrip := (GetEnv ('NOSTRIP') = 'true');
(* Get margin specifications *)
rightmargin := GetRightMargin;
prepipe := space;
postpipe := space;
IF (ParamCount = 2) THEN
IF ((rightmargin - (GetLeftMargin (prepipe, postpipe))) < minwidth) THEN
ShowHelp (1);
(* Get file specification, and the process files. *)
fPath := GetFilePath (ParamStr (1), fDir);
BuildFileList (fPath, fDir); { Build list of files. }
ProcessFiles (fDir);
END.